home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Misc Utils / ViewIt™ 2.2 Shareware / Projects / LS Fortran 3.0 Demos / vDemoLF.f < prev    next >
Text File  |  1993-09-20  |  4KB  |  133 lines
  1. C NOTE: Read the "MPW Fortrans" section of "About Compilers"
  2. C before compiling LF programs that use FaceWare modules.
  3.  
  4. C ViewIt 2.2 Demonstration Program
  5. C ©FaceWare 1991-93.  All Rights Reserved.
  6.  
  7. !!M Inlines.f
  8. !!I FaceProcLF.inc
  9.  
  10.       PROGRAM vDemoLF
  11.     implicit none
  12. C NOTE: If you use the "!!G" directive for precompiled globals, add
  13. C our FaceStorLF.inc globals to yours and then remove following line
  14.     include 'FaceStorLF.inc'
  15.       record /FaceRec/ fRec
  16.       common/FaceStuff/fRec
  17.     logical*4 helpShown
  18.     structure /DataRec/
  19.       integer*2 myInteger
  20.       real*4 myReal
  21.       character*100 myString
  22.       integer*4 myFlags
  23.     end structure
  24.     record /DataRec/ myRec
  25.     integer*2 myList
  26.     integer*4 myPtr,oldTicks,newTicks
  27.     real*4 theReal,delta
  28.  
  29.     myRec.myInteger = 0
  30.     myRec.myReal = 6.2
  31.     myRec.myString = 'Hello'
  32.     myRec.myFlags = 10
  33.     myList = 2
  34.     oldTicks = 0
  35.     theReal = 6.0
  36.  
  37. C Initialize FaceIt
  38.       fRec.uName = 'vDemo.Rsrc'
  39.       call FaceIt(0,DoInit,0,0,0,0)
  40.  
  41. C Open Modeless Window using FWND 1000
  42.     call FaceIt(0,NewWnd,1000,1,0,0)
  43.  
  44.       do while (.true.)
  45.         call FaceIt(0,DoLoop,0,0,0,0)
  46. C Standard "About" Menu Item Selection
  47.       if ((fRec.uMenuID = 101).and.(fRec.uMenuItem = 1)) then
  48.         fRec.uString = 'Demonstration of the use of ViewIt'
  49.      +//char(13)//'windows in a FaceIt-based program.'
  50.         call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
  51. C Hit in Modeless Window's "Open Modal" Button
  52.       else if ((fRec.uMenuID = 1000).and.(fRec.wcHit = 2)) then
  53.         call FaceIt(0,NewWnd,1001,0,0,0)  !Open Modal Window
  54.         do while (.true.)
  55.           call FaceIt(0,MdlWnd,1001,0,0,0)  !Process Modal Events
  56.         if (fRec.wcHit = -1) then        !Hit in Close Box
  57.           exit
  58.         else if (fRec.wcHit = 1) then     !Hit in "Open Nested"
  59.           myPtr = %loc(myRec)
  60.           call FaceIt(0,NewWnd,1002,0,110,myPtr)!Open Nested Modal
  61.           call FaceIt(0,GetCtl,1002,0,3,3)      !Link Scrollable List
  62.           call FaceIt(0,LnkCtl,fRec.cControl,%loc(myList),2,0)
  63.           call FaceIt(0,GetCtl,1002,0,2,3)      !Set Override Proc
  64.           call FaceIt(0,OvrCtl,fRec.cControl,%loc(OverProc),0,0)
  65.           call FaceIt(0,SetVal,1002,0,0,0)      !Set Linked Values
  66.           helpShown = .false.
  67.           do while (.true.)
  68.             call FaceIt(0,MdlWnd,1002,-2,0,0) !Process Modal Events
  69.             if (fRec.uMenuID = 0) then        !No Message
  70.               newTicks = TickCount
  71.             if (newTicks > oldTicks + 60) then
  72.               oldTicks = newTicks
  73.               call FaceIt(0,GetCtl,1002,0,2,8)
  74.               call SetCtlValue(%val(fRec.cControl),
  75.      +            %val(int2(mod(fRec.cValue,4) + 1)))
  76.             end if
  77.             else if (fRec.wvHit = 1) then      !Hit in View #1
  78.               if (fRec.wcHit = 1) then      !Hit in "OK" Button
  79.               exit
  80.             else if (fRec.wcHit = 2) then   !Hit in "Show/Hide"
  81.               if (helpShown) then
  82.                 call FaceIt(0,ShoCtl,0,0,-3,2)  !Hide v3, Show v2
  83.                 helpShown = .false.
  84.               else
  85.                 call FaceIt(0,ShoCtl,0,0,-2,3)  !Hide v2, Show v3
  86.                 helpShown = .true.
  87.               end if
  88.             end if
  89.             else if (fRec.wvHit = 2) then     !Hit in View #2
  90.               if ((fRec.wcHit = 6).or.(fRec.wcHit = 7)) then
  91.               call FaceIt(0,GetCtl,1002,0,2,int4(fRec.wcHit))
  92.               delta = 0.001 * (fRec.cMin - 2)
  93.               myRec.myReal = myRec.myReal + delta
  94.               call FaceIt(0,SetVal,1002,0,2,2)
  95.               call Delay(%val(5),fRec.uI4)
  96.             end if
  97.             end if
  98.           end do
  99.           call FaceIt(0,GetVal,1002,0,0,0)      !Get Linked Values
  100.           call FaceIt(0,EndWnd,1002,0,0,0)      !Close Nested Modal
  101.         end if
  102.         end do
  103.         call FaceIt(0,EndWnd,1001,0,0,0)  !Close Modal Window
  104. C Hit in Modeless Window's "Why ViewIt?" Button
  105.       else if ((fRec.uMenuID = 1000).and.(fRec.wcHit = 3)) then
  106.         call FaceIt(0,NewWnd,1003,0,0,%loc(theReal))
  107.         call FaceIt(0,SetVal,1003,0,0,0)
  108.         do while (.true.)
  109.           call FaceIt(0,MdlWnd,1003,0,0,0)
  110.         if (fRec.wcHit = 1) exit
  111.         end do
  112.         call FaceIt(0,GetVal,1003,0,0,0)
  113.         call FaceIt(0,EndWnd,1003,0,0,0)
  114.       end if
  115.     end do
  116.     end
  117.  
  118.     SUBROUTINE OverProc(%val(thePtr))
  119.     implicit none
  120. C NOTE: If you use the "!!G" directive for precompiled globals, add
  121. C our FaceStorLF.inc globals to yours and then remove following line
  122.     include 'FaceStorLF.inc'
  123.       record /FaceRec/ fRec
  124.       common/FaceStuff/fRec
  125.     integer*4 thePtr
  126.     if (fRec.uCommand = 264) then    !a key down message?
  127.       if (fRec.uParam(1) = 32) then  !SPACE key pressed?
  128.         fRec.uParam(1) = 95          !convert to UNDERLINE
  129.       end if
  130.     end if
  131.     call fJumpIt(%val(long(thePtr)),thePtr) !pass message to driver
  132.     end
  133.